unit g_uCreateComponentTools;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, jpeg, DBClient, ShareObj, ExtCtrls, cxControls, cxContainer, cxEdit, cxLabel;
type
TImageType = (IT_None, IT_Error, IT_Bmp, IT_JPEG, IT_GIF, IT_PCX, IT_PNG, IT_PSD, IT_RAS, IT_SGI, IT_TIFF);
function fixFull2TPanel(aParentPanel: TPanel; nRows, nCols, nALLWidth, nALLHeight: Integer): Boolean;
function fixRecd2TPanel(aParentPanel: TPanel; nRows, nCols, nPageIndex: Integer; aClientDataSet: TClientDataSet): Boolean;
implementation
function fixOptChildPanel(sOpt: string; nIndex: Integer; aParentPanel: TPanel): Boolean;
var
i, k: Integer;
aPanle: TPanel;
acxLabel: TcxLabel;
aImage: TImage;
lv_sOpt: string;
begin
try
lv_sOpt := LowerCase(Trim(sOpt));
if lv_sOpt = 'disable' then
begin
for i := 0 to aParentPanel.ControlCount-1 do
begin
if aParentPanel.Controls[i] is TPanel then
begin
aPanle := TPanel(aParentPanel.Controls[i]);
if aPanle.Tag >= nIndex then
begin
aPanle.Visible := False;
aPanle.Hint := '';
for k := 0 to aPanle.ControlCount - 1 do
begin
if aPanle.Controls[k] is TcxLabel then
TcxLabel(aPanle.Controls[k]).Caption := ''
else if aPanle.Controls[k] is TImage then
TImage(aPanle.Controls[k]).Picture.Graphic := nil;
end;
end;
end;
end;
end else if lv_sOpt = 'free' then
begin
while aParentPanel.ControlCount > 0 do
begin
if aParentPanel.Controls[0] is TPanel then
begin
aPanle := TPanel(aParentPanel.Controls[0]);
while aPanle.ControlCount > 0 do
begin
if aPanle.Controls[0] is TcxLabel then
begin
acxLabel := TcxLabel(aPanle.Controls[0]);
acxLabel.Caption := '';
FreeAndNil(acxLabel);
end else if aPanle.Controls[0] is TImage then
begin
aImage := TImage(aPanle.Controls[0]);
aImage.Picture.Graphic := nil;
FreeAndNil(aImage);
end;
end;
aPanle.Hint := '';
FreeAndNil(aPanle);
end;
end;
end;
except
on e:Exception do
begin
ShowMessage(e.Message);
end;
end;
end;
function findChildPanel(aParentPanel: TPanel): TObjectHashedList;
var
i: Integer;
aPanle: TPanel;
begin
try
Result := TObjectHashedList.Create;
for i := 0 to aParentPanel.ControlCount-1 do
begin
if aParentPanel.Controls[i] is TPanel then
begin
aPanle := TPanel(aParentPanel.Controls[i]);
Result.AddObject(IntToStr(aPanle.Tag), aPanle);
aPanle := nil;
end;
end;
except
on e:Exception do
begin
end;
end;
end;
function CreateMyTCardPanel(nTop, nLeft, nWidth, nHeight: Integer): TPanel;
var
aPanel: TPanel;
aImage: TImage;
acxLabel1, acxLabel2: TcxLabel;
const
C_LABLE_HEIGHT = 50;
C_LABLE_FONTSIZE = 24;
begin
Result := nil;
try
aPanel := TPanel.Create(nil);
aPanel.BevelInner := bvNone;
aPanel.BevelOuter := bvNone;
aPanel.Color := clGreen;
aPanel.SetBounds(nLeft, nTop, nWidth, nHeight);
acxLabel1 := TcxLabel.Create(nil);
acxLabel1.Parent := aPanel;
acxLabel1.AutoSize := False;
acxLabel1.Height := C_LABLE_HEIGHT;
acxLabel1.Properties.Alignment.Horz := taCenter;
acxLabel1.Properties.Alignment.Vert := taVCenter;
acxLabel1.Style.Font.Size := C_LABLE_FONTSIZE;
acxLabel1.SetBounds(0, nHeight-C_LABLE_HEIGHT, nWidth, C_LABLE_HEIGHT);
acxLabel1.Tag := 0;
acxLabel2 := TcxLabel.Create(nil);
acxLabel2 := TcxLabel.Create(nil);
acxLabel2.Parent := aPanel;
acxLabel2.AutoSize := False;
acxLabel2.Height := C_LABLE_HEIGHT;
acxLabel2.Properties.Alignment.Horz := taCenter;
acxLabel2.Properties.Alignment.Vert := taVCenter;
acxLabel2.Style.Font.Size := C_LABLE_FONTSIZE;
acxLabel2.SetBounds(0, nHeight-C_LABLE_HEIGHT*2, nWidth, C_LABLE_HEIGHT);
acxLabel2.Tag := 1;
aImage := TImage.Create(nil);
aImage.Parent := aPanel;
aImage.SetBounds(0, 0, nWidth, nHeight-C_LABLE_HEIGHT*2);
Result := aPanel;
except
on e:Exception do
begin
end;
end;
end;
function FindImageType(Buffer: Word): TImageType;
begin
case Buffer of
$4D42:
Result := IT_Bmp;
$D8FF:
Result := IT_JPEG;
$4947:
Result := IT_GIF;
$050A:
Result := IT_PCX;
$5089:
Result := IT_PNG;
$4238:
Result := IT_PSD;
$A659:
Result := IT_RAS;
$DA01:
Result := IT_SGI;
$4949:
Result := IT_TIFF;
else
Result := IT_None;
end;
end;
function doJpgAndBmp2TBitmap(sPicPath: string; nWidth, nHeight: Integer): TBitmap;
var
aBuffre: Word;
aImageType: TImageType;
aStream: TMemoryStream;
Jpg: TJPEGImage;
Bmp: TBitmap;
begin
Result := nil;
try
if FileExists(sPicPath) then
begin
aStream := TMemoryStream.Create;
aStream.LoadFromFile(sPicPath);
aStream.Position := 0;
aStream.ReadBuffer(aBuffre, 2);
try
aImageType := FindImageType(aBuffre);
if aImageType = IT_JPEG then
begin
Jpg := TJPEGImage.Create;
Bmp := TBitmap.Create;
try
Jpg.LoadFromFile(sPicPath);
Bmp.Width := nWidth;
Bmp.Height:= nHeight;
Bmp.Canvas.StretchDraw(Rect(0, 0, nWidth, nHeight), Jpg);
Jpg.Assign(Bmp);
Result := TBitmap.Create;
Result.Assign(Jpg);
finally
FreeAndNil(Bmp);
FreeAndNil(Jpg);
end;
end else if aImageType = IT_Bmp then
begin
Result := TBitMap.Create;
Result.LoadFromFile(sPicPath);
Bmp := TBitMap.Create;
try
Bmp.Width := nWidth;
Bmp.Height := nHeight;
Bmp.Canvas.StretchDraw(rect(0, 0, nWidth, nHeight), Result);
Result.Assign(Bmp);
finally
Bmp.Free;
end;
end else begin
Result := TBitMap.Create;
Result.Height := nWidth;
Result.Width := nHeight;
end;
finally
FreeAndNil(aStream);
end;
end;
except
on e: Exception do
begin
end;
end;
end;
function doTBitMapDrawPolygon(Bmp: TBitMap; sText: string): TBitMap;
var
lf: TLogFont;
tf: TFont;
nWidth, nHeight: Integer;
aPoints: array[0..2] of TPoint;
lv_bRet: Boolean;
lv_stemp: string;
const
C_CORNER_LENGTH = 45;
C_FONT_SIZE = 9;
begin
Result := nil;
try
if not Assigned(Bmp) then
Bmp := TBitmap.Create;
if Bmp.Empty then
begin
Bmp.Height := 120;
Bmp.Width := 120;
end;
nWidth := Bmp.Width;
nHeight := 0;
aPoints[0] := Point(nWidth, 0);
aPoints[1] := Point(nWidth, C_CORNER_LENGTH);
aPoints[2] := Point(nWidth - C_CORNER_LENGTH, 0);
with Bmp.Canvas do
begin
Pen.Width := 1;
Pen.Color := clWhite;
Brush.Color := clMenuHighlight;
Polygon(aPoints);
end;
with Bmp.Canvas do
begin
Font.Color := clWhite;
Font.Size := C_FONT_SIZE;
Font.Name := '宋体';
tf := TFont.Create;
tf.Assign(Font);
GetObject(tf.Handle, sizeof(lf), @lf);
lf.lfEscapement := -450;
lf.lfOrientation := -450;
tf.Handle := CreateFontIndirect(lf);
Font.Assign(tf);
tf.Free;
TextOut(Bmp.Width - (C_CORNER_LENGTH div 3), 2, sText);
end;
Result := Bmp;
except
on e: Exception do
begin
end;
end;
end;
procedure fixProperties2MyTCardPanel(aPanel: TPanel; sGoodsCode, sGoodsName, sPicName: string; cGoodsPrice: Currency; nFixTag: Integer);
var
i: Integer;
Bmp: TBitMap;
lv_sAppPath, lv_sPicPath: string;
begin
try
lv_sAppPath := ExtractFilePath(ParamStr(0));
aPanel.Hint := sGoodsCode;
for i:= 0 to aPanel.ControlCount - 1 do
begin
if aPanel.Controls[i] is TcxLabel then
begin
if TcxLabel(aPanel.Controls[i]).Tag = 0 then
TcxLabel(aPanel.Controls[i]).Caption := '￥' + CurrToStr(cGoodsPrice)
else
TcxLabel(aPanel.Controls[i]).Caption := sGoodsName;
end else if aPanel.Controls[i] is TImage then
begin
lv_sPicPath := lv_sAppPath + sPicName;
case nFixTag of
1: Bmp := doTBitMapDrawPolygon(doJpgAndBmp2TBitmap(lv_sPicPath, TImage(aPanel.Controls[i]).Width, TImage(aPanel.Controls[i]).Height), '套餐');
2: Bmp := doTBitMapDrawPolygon(doJpgAndBmp2TBitmap(lv_sPicPath, TImage(aPanel.Controls[i]).Width, TImage(aPanel.Controls[i]).Height), '配比');
else
Bmp := doJpgAndBmp2TBitmap(lv_sPicPath, TImage(aPanel.Controls[i]).Width, TImage(aPanel.Controls[i]).Height);
end;
TImage(aPanel.Controls[i]).Stretch := False;
TImage(aPanel.Controls[i]).Picture.Assign(Bmp);
Bmp.Free;
end;
end;
except
on e:Exception do
begin
end;
end;
end;
function fixFull2TPanel(aParentPanel: TPanel; nRows, nCols, nALLWidth, nALLHeight: Integer): Boolean;
var
x, y, k: Integer;
lv_nSingleWidth, lv_nSingleHeight: Integer;
aPanle: TPanel;
begin
Result := False;
try
lv_nSingleWidth := nALLWidth div nCols;
lv_nSingleHeight := nALLHeight div nRows;
k := 1;
for x := 1 to nRows do
begin
for y := 1 to nCols do
begin
aPanle := CreateMyTCardPanel((x-1)*lv_nSingleHeight, (y-1)*lv_nSingleWidth, lv_nSingleWidth, lv_nSingleHeight);
aPanle.Parent := aParentPanel;
aPanle.Visible := False;
aPanle.Tag := k;
aPanle.Caption := IntToStr(k);
aPanle := nil;
Inc(k);
end;
end;
Result := k > 0;
except
on e:Exception do
begin
end;
end;
end;
function fixRecd2TPanel(aParentPanel: TPanel; nRows, nCols, nPageIndex: Integer; aClientDataSet: TClientDataSet): Boolean;
var
i, nTag, nIndex1, nIndex2: Integer;
aHashMapTPanel: TObjectHashedList;
aPanle: TPanel;
lv_nTagFalg: Integer;
lv_cGoodsPrice: Currency;
lv_sGoodsCode, lv_sGoodsName, lv_sImageName, lv_sTmp: string;
begin
Result := False;
try
nIndex1 := (nPageIndex - 1) * (nRows * nCols) + 1;
nIndex2 := nPageIndex * (nRows * nCols);
try
aClientDataSet.Filtered := False;
aClientDataSet.Filter := 'CySortNo >= ' + IntToStr(nIndex1) + ' and CySortNo <= ' + IntToStr(nIndex2);
aClientDataSet.Filtered := True;
if aClientDataSet.RecordCount > 0 then
begin
aHashMapTPanel := findChildPanel(aParentPanel);
if aHashMapTPanel.Count > 0 then
begin
// fixOptChildPanel('disable', aParentPanel);
with aClientDataSet do
begin
First;
i := 1;
while not Eof do
begin
lv_sTmp := IntToStr(FieldByName('CySortNo').AsInteger);
lv_sImageName := FieldByName('CyImageName').AsString;
lv_sGoodsCode := FieldByName('CyGoodsCode').AsString;
lv_sGoodsName := FieldByName('CyGoodsName').AsString;
lv_cGoodsPrice := FieldByName('CyGoodsPrice').AsCurrency;
if FieldByName('CyPackageFlag').AsInteger = 1 then
lv_nTagFalg := 1
else if FieldByName('CyProportionFlag').AsInteger = 1 then
lv_nTagFalg := 2
else
lv_nTagFalg := 0;
aPanle := TPanel(aHashMapTPanel.GetByCode(IntToStr(i)));
if aPanle <> nil then
begin
aPanle.Visible := True;
fixProperties2MyTCardPanel(aPanle, lv_sGoodsCode, lv_sGoodsName, lv_sImageName, lv_cGoodsPrice, lv_nTagFalg);
end;
aPanle := nil;
Inc(i);
Next;
end;
end;
if i <= nRows*nCols then
fixOptChildPanel('disable', i ,aParentPanel);
end else
Exit;
end else
Exit;
Result := i > 0;
finally
aClientDataSet.Filtered := False;
aClientDataSet.Filter := '';
aClientDataSet.Filtered := True;
end;
except
on e:Exception do
begin
end;
end;
end;
end.
