frxctrls.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

           begin
             // This check is necessary to be sure that combo is created, not
             // RECREATED (somehow CM_RECREATEWND does not work)
             SetWindowLong(FListHandle, GWL_WNDPROC, Longint(FDefListProc));
             FDefListProc:= nil;
             FChildHandle:= Message.lParam;
           end
          else
           begin
             // WM_Create is the only event I found where I can get the ListBox handle.
             // The fact that combo box usually creates more then 1 handle complicates the
             // things, so I have to have the FChildHandle to resolve it later (in CreateWnd).
             if FChildHandle = 0 then
               FChildHandle:= Message.lParam
             else
               FListHandle:= Message.lParam;
           end;
       end;
    WM_WINDOWPOSCHANGING:
      MoveWindow(EditHandle, 3+FEditOffset, 3, Width-FButtonWidth-7-FEditOffset,
        Height-6, True);
  end;
  inherited;
end;

procedure TfrxCustomComboBox.WMPaint(var Message:TWMPaint);
var
  PS, PSE:TPaintStruct;
begin
  BeginPaint(Handle,PS);
  try
    if Enabled then
    begin
      DrawImage(PS.HDC, ItemIndex ,Rect(3, 3, FEditOffset+3, Height-3));
      if GetSolidBorder then
      begin
        PaintBorder(PS.HDC, True);
        if DroppedDown then
          PaintButton(2)
        else
          PaintButton(1);
      end else
      begin
        PaintBorder(PS.HDC, False);
        PaintButton(0);
      end;
    end else
    begin
      BeginPaint(EditHandle, PSE);
      try
        PaintDisabled;
      finally
        EndPaint(EditHandle, PSE);
      end;
    end;
  finally
    EndPaint(Handle,PS);
  end;
  Message.Result:= 0;
end;

procedure TfrxCustomComboBox.DrawImage(DC:HDC; Index:Integer; R:TRect);
begin
  if FEditOffset > 0 then
   FillRect(DC, R, GetSysColorBrush(COLOR_WINDOW));
end;

procedure TfrxCustomComboBox.ComboWndProc(var Message:TMessage; ComboWnd:HWnd;
  ComboProc:Pointer);
var
  DC:HDC;
begin
  inherited;
  if (ComboWnd = EditHandle) then
    case Message.Msg of
      WM_SETFOCUS:
        begin
          DC:=GetWindowDC(Handle);
          PaintBorder(DC,True);
          PaintButton(1);
          ReleaseDC(Handle,DC);
        end;
      WM_KILLFOCUS:
        begin
          DC:=GetWindowDC(Handle);
          PaintBorder(DC,False);
          PaintButton(0);
          ReleaseDC(Handle,DC);
        end;
    end;
end;

procedure TfrxCustomComboBox.CNCommand(var Message:TWMCommand);
begin
  inherited;
  if (Message.NotifyCode in [CBN_CLOSEUP]) then
    PaintButton(1);
end;

procedure TfrxCustomComboBox.PaintBorder(DC:HDC; const SolidBorder:Boolean);
var
  R:TRect;
  BtnFaceBrush, WindowBrush:HBRUSH;
begin
  BtnFaceBrush:= GetSysColorBrush(COLOR_BTNFACE);
  WindowBrush:= GetSysColorBrush(COLOR_WINDOW);
  GetWindowRect(Handle, R);
  OffsetRect (R,-R.Left,-R.Top);
  InflateRect(R,-1,-1);
  FrameRect (DC, R, BtnFaceBrush);
  InflateRect(R,-1,-1);
  R.Right:=R.Right-FButtonWidth-1;
  FrameRect (DC, R, WindowBrush);
  if SolidBorder then
  begin
    GetWindowRect(Handle, R);
    OffsetRect (R,-R.Left,-R.Top);
    DrawEdge (DC, R, BDR_SUNKENOUTER, BF_RECT);
  end else
  begin
    GetWindowRect(Handle, R);
    OffsetRect (R,-R.Left,-R.Top);
    FrameRect (DC, R, BtnFaceBrush);
  end;
end;

procedure TfrxCustomComboBox.PaintButtonGlyph(DC:HDC; x:Integer; y:Integer);
var
  Pen, SavePen:HPEN;
begin
  Pen:= CreatePen(PS_SOLID, 1, ColorToRGB(clBlack));
  SavePen:= SelectObject(DC, Pen);
  MoveToEx(DC, x, y, nil);
  LineTo(DC, x+5, y);
  MoveToEx(DC, x+1, y+1, nil);
  LineTo(DC, x+4, y+1);
  MoveToEx(DC, x+2, y+2, nil);
  LineTo(DC, x+3, y+2);
  SelectObject(DC, SavePen);
  DeleteObject(Pen);
end;

procedure TfrxCustomComboBox.PaintButton(bnStyle:Integer);
var
  R:TRect;
  DC:HDC;
  Brush, SaveBrush:HBRUSH;
  X, Y:Integer;
  Pen, SavePen:HPEN;
  WindowBrush:HBRUSH;
begin
  WindowBrush:= GetSysColorBrush(COLOR_WINDOW);
  DC:= GetWindowDC(Handle);
  SetRect(R, Width-FButtonWidth-2, 2, Width-2, Height-2);
  Brush:= CreateSolidBrush(GetSysColor(COLOR_BTNFACE));
  SaveBrush:= SelectObject(DC, Brush);
  FillRect(DC, R, Brush);
  SelectObject(DC, SaveBrush);
  DeleteObject(Brush);
  X:= Trunc(FButtonWidth / 2)+Width-FButtonWidth-4;
  Y:= Trunc((Height-4) / 2)+1;
  if bnStyle = 0 then //No 3D border
  begin
    FrameRect (DC, R, WindowBrush);
    GetWindowRect(Handle, R);
    OffsetRect (R,-R.Left,-R.Top);
    InflateRect(R,-FButtonWidth-3,-2);
    Pen:= CreatePen(PS_SOLID, 1, ColorToRGB(clWindow));
    SavePen:= SelectObject(DC, Pen);
    MoveToEx(DC,R.Right, R.Top, nil);
    LineTo(DC, R.Right, R.Bottom);
    SelectObject(DC, SavePen);
    DeleteObject(Pen);
    PaintButtonGlyph(DC, X, Y);
  end;
  if bnStyle = 1 then //3D up border
  begin
    DrawEdge (DC, R, BDR_RAISEDINNER, BF_RECT);
    GetWindowRect(Handle, R);
    OffsetRect (R,-R.Left,-R.Top);
    InflateRect(R,-FButtonWidth-3,-1);
    Pen:= CreatePen(PS_SOLID, 1, ColorToRGB(clBtnFace));
    SavePen:= SelectObject(DC, Pen);
    MoveToEx(DC, R.Right, R.Top, nil);
    LineTo(DC, R.Right, R.Bottom);
    SelectObject(DC, SavePen);
    DeleteObject(Pen);
    PaintButtonGlyph(DC, X, Y);
  end;
  if bnStyle = 2 then //3D down border
  begin
    DrawEdge (DC, R, BDR_SUNKENOUTER, BF_RECT);
    GetWindowRect(Handle, R);
    OffsetRect (R,-R.Left,-R.Top);
    InflateRect(R,-FButtonWidth-3,-1);
    Pen:= CreatePen(PS_SOLID, 1, ColorToRGB(clBtnFace));
    SavePen:= SelectObject(DC, Pen);
    MoveToEx(DC, R.Right, R.Top, nil);
    LineTo(DC, R.Right, R.Bottom);
    SelectObject(DC, SavePen);
    DeleteObject(Pen);
    PaintButtonGlyph(DC, X+1, Y+1);
  end;
  ReleaseDC(Handle, DC);
end;

procedure TfrxCustomComboBox.PaintDisabled;
var
  R:TRect;
  Brush, SaveBrush:HBRUSH;
  DC:HDC;
  WindowBrush:HBRUSH;
begin
  WindowBrush:= GetSysColorBrush(COLOR_WINDOW);
  DC:= GetWindowDC(Handle);
  Brush:= CreateSolidBrush(GetSysColor(COLOR_BTNFACE));
  SaveBrush:= SelectObject(DC, Brush);
  FillRect(DC, ClientRect, Brush);
  SelectObject(DC, SaveBrush);
  DeleteObject(Brush);
  R:= ClientRect;
  InflateRect(R,-2,-2);
  FrameRect (DC, R, WindowBrush);
  PaintButtonGlyph(DC, Trunc(FButtonWidth / 2)+Width-FButtonWidth-4,
    Trunc((Height-4) / 2)+1);
  ReleaseDC(Handle,DC);
end;

procedure TfrxCustomComboBox.CMEnabledChanged(var Msg:TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TfrxCustomComboBox.CMMouseEnter(var Message:TMessage);
var
  DC:HDC;
begin
  inherited;
  msMouseInControl:= True;
  if Enabled and not (GetFocus = EditHandle) and not DroppedDown then
  begin
    DC:=GetWindowDC(Handle);
    PaintBorder(DC, True);
    PaintButton(1);
    ReleaseDC(Handle, DC);
  end;
end;

procedure TfrxCustomComboBox.CMMouseLeave(var Message:TMessage);
var
  DC:HDC;
begin
  inherited;
  msMouseInControl:= False;
  if Enabled and not (GetFocus = EditHandle) and not DroppedDown then
  begin
    DC:=GetWindowDC(Handle);
    PaintBorder(DC, False);
    PaintButton(0);
    ReleaseDC(Handle, DC);
  end;
end;

function TfrxCustomComboBox.GetSolidBorder:Boolean;
begin
  Result:= ((csDesigning in ComponentState)) or
    (DroppedDown or (GetFocus = EditHandle) or msMouseInControl);
end;

function TfrxCustomComboBox.GetListHeight:Integer;
begin
  Result:= ItemHeight * Min(DropDownCount, Items.Count)+4;
  if (DropDownCount <= 0) or (Items.Count = 0) then
    Result:= ItemHeight+4;
end;

procedure TfrxCustomComboBox.CMFontChanged(var Message:TMessage);
begin
  inherited;
  ItemHeight:= GetFontHeight(Font);
  RecreateWnd;
end;

{ TfrxFontComboBox }

function CreateBitmap(ResName:PChar):TBitmap;
begin
   Result:= TBitmap.Create;
   Result.Handle:= LoadBitmap(HInstance, ResName);
   if Result.Handle = 0 then
   begin
     Result.Free;
     Result:= nil;
   end;
end;

function EnumFontsProc(var LogFont:TLogFont; var TextMetric:TTextMetric;
  FontType:Integer; Data:Pointer):Integer; stdcall;
begin
  if (TStrings(Data).IndexOf(LogFont.lfFaceName) < 0) then
    TStrings(Data).AddObject(LogFont.lfFaceName, TObject(FontType));
  Result:= 1;
end;

constructor TfrxFontComboBox.Create(AOwner:TComponent);
begin
  inherited Create(AOwner);
  if not (csDesigning in ComponentState) then
    frFontViewForm:= TfrxFontPreview.Create(Self);
  FTrueTypeBMP:= CreateBitmap('FRXTRUETYPE_FNT');
  DropDownCount:= 12;
  Width:= 150;
  FEditOffset:= 16;
  FReadOnly:= True;
  FShowMRU:= True;
  Numused:=-1;
  MRURegKey:= '';
end;

destructor TfrxFontComboBox.Destroy;
begin
  FTrueTypeBMP.Free;
  if not (csDesigning in ComponentState) then
    frFontViewForm.Destroy;
  inherited Destroy;
end;

procedure TfrxFontComboBox.Loaded;
begin
  inherited Loaded;
  if csDesigning in ComponentState then exit;
  FUpdate:= True;
  try
    PopulateList;
    if Items.IndexOf(Text) =-1 then
      ItemIndex:=0;
  finally
    FUpdate:= False;
  end;
end;

procedure TfrxFontComboBox.SetRegKey(Value:String);
begin
  if Value = '' then
    FRegKey:= '\Software\Fast Reports\MRUFont' else
    FRegKey:= Value;
end;

procedure TfrxFontComboBox.PopulateList;
var
  LFont:TLogFont;
  DC:HDC;
  Reg:TRegistry;
  s:String;
  i:Integer;
  str:TStringList;
begin
  Sorted:=True;
  Items.BeginUpdate;
  str:= TStringList.Create;
  str.Sorted:= True;
  try
    Clear;
    DC:= GetDC(0);
    try
      FillChar(LFont, sizeof(LFont), 0);
      LFont.lfCharset:= DEFAULT_CHARSET;
      EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, LongInt(str), 0);
    finally
      ReleaseDC(0, DC);
    end;
    if Printer.Printers.Count > 0 then
    try
      FillChar(LFont, sizeof(LFont), 0);
      LFont.lfCharset:= DEFAULT_CHARSET;
      EnumFontFamiliesEx(Printer.Handle, LFont, @EnumFontsProc, LongInt(str), 0);
    except;
    end;
  finally
    Items.Assign(str);
    Items.EndUpdate;
  end;
  str.Free;
  Sorted:= False;
  if FShowMRU then
  begin
    Items.BeginUpdate;
    Reg:=TRegistry.Create;
    try
      Reg.OpenKey(FRegKey, True);
      for i:= 4 downto 0 do
      begin
        s:= Reg.ReadString('Font'+IntToStr(i));
        if (s<>'') and (Items.IndexOf(s)<>-1) then
        begin
          Items.InsertObject(0, s, TObject(Reg.ReadInteger('FontType'+IntToStr(i))));
          Inc(Numused);
        end else
        begin
          Reg.WriteString('Font'+IntToStr(i), '');
          Reg.WriteInteger('FontType'+IntToStr(i), 0);
        end;
      end;
    finally
      Reg.Free;
      Items.EndUpdate;
    end;
  end;
end;

procedure TfrxFontComboBox.DrawImage(DC:HDC; Index:Integer; R:TRect);
var
  C:TCanvas;
  Bitmap:TBitmap;
begin
  inherited;
  Index:= Items.IndexOf(Text);
  if Index =-1 then exit;
  C:= TCanvas.Create;
  C.Handle:= DC;
  if (Integer(Items.Objects[Index]) and TRUETYPE_FONTTYPE)<>0 then
    Bitmap:= FTrueTypeBMP
  else Bitmap:= nil;
  if Bitmap<>nil then
  begin
    C.Brush.Color:= clWindow;
    C.BrushCopy(Bounds(R.Left, (R.Top+R.Bottom-Bitmap.Height)
     div 2, Bitmap.Width, Bitmap.Height), Bitmap, Bounds(0, 0, Bitmap.Width,
     Bitmap.Height), Bitmap.TransparentColor);
  end;
  C.Free;
end;

procedure TfrxFontComboBox.DrawItem(Index:Integer; Rect:TRect;
  State:TOwnerDrawState);
var
  Bitmap:TBitmap;
  BmpWidth:Integer;