꿀항아리

1. Delphi에서 WebBrowser을 이용하여 popup을 띄우기

//새창을 띄울경우 원하는폼에 팝업을 띄울수 있다.

procedure TfrmMain.WebBrowser1NewWindow2(ASender: TObject;

  var ppDisp: IDispatch; var Cancel: WordBool);

var

     Form2: TForm1;

begin

     Form2 := TfrmNotice.Create( nil );

     ppDisp := Form2.WebBrowser1.DefaultInterface;

     Form2.Show;

end;

1-1. Delphi에서 WebBrowser을 이용하여 popup을 띄운후 닫히는 시점알기

   1) HTML 에서  window.close();를 찾아내어 

     window.status='close';를 적용한다.

     ...

     .....

    <script language="javascript">

      function XXXXXXXX
     {
         window.status='close';
         window.close();
     }
    </script>

     .....

     ...

   2) Delphi 에서 WebBrowser 의  StatusTextChange event에 작성한다.

procedure TfrmNotice.WebBrowser1StatusTextChange(ASender: TObject;  const Text: WideString);

var

     sWindowResult : string;

begin

     if sWindowResult = 'close' then

     begin

Close

end;

end;

 cf)  특정pc에서 작동이 잘 안된다..

      아래 WebBrowser1WindowClosing에다 작업하는것이 훨씬 수월함

1-2. Delphi에서 WebBrowser을 이용하여 popup을 띄운후 닫히는 시점알기

procedure TfrmZipHelp.WebBrowser1WindowClosing(ASender: TObject;IsChildWindow: WordBool; var Cancel: WordBool);

begin

//주소 자료 끌어오는 코딩 작업한다.

end;

ps. WebBrowser1 강제죵료하기

procedure ParentNotify(var Msg: TMessage); message WM_PARENTNOTIFY;

implementation of message handler:

procedure TMyForm.ParentNotify(Var Msg: TMessage);

begin

  if (msg.WParamLo = WM_DESTROY) and (msg.LParam = WebBrowser1.Handle) then close;

end;

--------------------------------------------------------------------------------------

2. Delphi에서 WebBrowser을 이용하여 popup을 띄우기

   1) html에서 아래와 같이 name 설정이 되어 있어야 한다.

<input type="button" name='btn' value="주소검색" onclick="goPopup();">

   2) Delphi 에서 WebBrowser에서  name='btn' 로 설정된 값을 찾아 click event를 실행한다.

procedure TfrmMain.WebBrowser1DocumentComplete(ASender: TObject;

  const pDisp: IDispatch; const URL: OleVariant);

var

     i : integer;

begin

    for i := 0 to WebBrowser1.OleObject.document.body.getelementsbytagname('INPUT').Length - 1 do

    begin

        if (WebBrowser1.OleObject.document.body.getelementsbytagname('INPUT').Item(i).NAME = 'btn') then           begin

            WebBrowser1.OleObject.document.body.getelementsbytagname('INPUT').Item(i).Click;

            break;

        end;

    end;

end;

- 암호화 복호화

select

decrypt(decode(sec_test::varchar(50), 'hex')::bytea, '0123456789', 'cast5'),

encode(encrypt((juno_test)::bytea, '0123456789'::bytea, 'cast5'), 'hex')

from test

- 필드 검색

SELECT pg_class.relname, pg_attribute.attname, pg_type.typname, pg_attribute.atttypmod-4

FROM pg_class, pg_attribute, pg_type

WHERE pg_attribute.attrelid = pg_class.oid 

AND pg_attribute.atttypid = pg_type.oid 

--AND pg_class.relname = '테이블명'

and pg_attribute.attname like '%secno%'

order by relname

HogeQRImage.pas

http://ari-memo.seesaa.net/article/161535795.html

-----------------------------------------------------------------------------------

今更Delphi7？(^^;
昨日Delphi XEが発売されたがな～！という話は置いといて(^^;

仕事上、どうしても必要で調査＆作成。

○手法
　１）VCLのDrawを回避、自力描画
　　「中村の里」　http://www.asahi-net.or.jp/~HA3T-NKMR/tips004.htm　がベースです。
　２）Delphiのメモリ管理を回避
　　SetLengthをGlobalAlloc(API)に変更
　　Delphi-ML　http://leed.issp.u-tokyo.ac.jp/~takeuchi/delphi/browse.cgi?index=063699&back=http%3A%2F%2Fw3%2Esfdata%2Ene%2Ejp%2FML%2FCB%2Fmsg25648%2Ehtml　がベースです。

　どちらも中村さんの調査と発表がなければ到底回避できませんでした。本当に感謝です m(__)m

○前提・制限
　・Delphi7&添付のQuickReportでしか試していません。
　・2000/XPで動作確認。
　・Metafileは非対応(元の処理に丸投げ)
　・『画像が抜けない』は飽くまで当方での調査結果からの話であり、皆様の所でも
必ず同じ状況が起こる、または起こらない事を保証するものではありません。
　・無保証・自己責任でお使い下さい(お約束)
　・商用/非商用問わず、ソースの改変などご自由に。

---------------------------------
ダウンロード: HogeQRImage.pas
---------------------------------

// 適当な名前に置換して下さい
unit HogeQRImage;

interface

uses
  Windows, Classes, Graphics, JPEG, Math, SysUtils, Dialogs, Forms,
  qrctrls, quickrpt, qrprntr, SyncObjs;

// Cardinalで戻して欲しいので自己定義
function KStretchDIBits(DC: HDC; DestX, DestY, DestWidth, DestHeight, SrcX,
  SrcY, SrcWidth, SrcHeight: Integer; Bits: Pointer; var BitsInfo: TBitmapInfo;
  Usage: UINT; Rop: DWORD): Cardinal; stdcall; external gdi32 name 'StretchDIBits';

type
  // 適当な名前に置換して下さい
  THogeQRImage = class(TQRImage)
  protected
    procedure Print(OfsX, OfsY : integer); override;
  end;

procedure Register;

implementation

uses StrUtils;

var
  CRITICAL_SECTION: TCriticalSection;

procedure Register;
begin
  RegisterComponents('QReport', [THogeQRImage]);	// 適当な名前に置換して下さい
end;

// ここで調査記録
procedure WriteLog(sLog: string);
begin
  // 必要があればロジックを埋めて下さい
end;

// APIエラーの内容取得(汎用)
function GetAPIErrorMessage(caError: cardinal): string;
const
  MAX_BUF = 1024;
var
  buf: PChar;
begin
  result := '[' + CurrToStr(caError) + ']';
  Buf := AllocMem(MAX_BUF);
  try
    FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, caError, 0, buf, MAX_BUF, nil);
    result := result + buf;
  finally
    FreeMem(Buf);
  end;
end;

// 最終APIエラーの内容取得
function GetLastAPIErrorMes(): string;
begin
  result := GetAPIErrorMessage(GetLastError);
end;

// 中村さんTipsから
//   API結果判定(失敗時、例外を投げるように) 2010.06.03 Edit(ARI)
procedure StretchDrawBitmap(Canvas:TCanvas;  // 描画先キャンバス
                            r : TRect;       // 描画先範囲
                            Bitmap:TBitmap); // ビットマップ
const
  InfoSize = SizeOf(TBitmapInfoHeader) + 4 * 256;
var
  OldMode   : integer;      // StretchModeの保存用
  pInfo     : PBitmapInfo;  // DIBヘッダ＋カラーテーブルへのポインタ

  InfoData  : array[0..InfoSize-1] of Byte; // DIBヘッダ＋カラーテーブル
  Image     : PByte;        // DIBのピクセルデータ
  DC        : HDC;          // GetDIBits 用 Device Context
  OldPal    : HPALETTE;     // パレット保存用

  ret: cardinal;
  nSize: integer;
begin
    SetLastError(0);

    pInfo :=@InfoData;

    // 24 Bit DIB の領域を確保
    nSize := ((Bitmap.Width * 24 + 31) div 32) * 4 * Bitmap.Height;
    Image := PByte(GlobalAlloc(GMEM_FIXED or GMEM_ZEROINIT, nSize));

    if Image = nil then begin
      // メモリ確保失敗、再チャレンジ
      Image := PByte(GlobalAlloc(GMEM_FIXED or GMEM_ZEROINIT, nSize));
      if Image = nil then begin
        // 再チャレンジも失敗
        raise Exception.Create('GlobalAlloc = nil : ' + GetLastAPIErrorMes());
      end;
    end;

    try
      // DIB のBitmapInfoHeader を初期化
      with pInfo^.bmiHeader do begin
        biSize := SizeOf(TBitmapInfoHeader);
        biWidth := Bitmap.Width;     biHeight := Bitmap.Height;
        biPlanes := 1;               biBitCount := 24;
        biCompression := BI_RGB;
      end;

      // 24bpp DIB イメージを取得
      DC := GetDC(0);
      if DC = 0 then begin
        // 失敗
        raise Exception.Create('GetDC = nil : ' + GetLastAPIErrorMes());
      end;

      try
        OldPal := 0;
        if Bitmap.Palette <> 0 then begin
          OldPal := SelectPalette(DC, Bitmap.Palette, True);
          if OldPal = 0 then begin
            // 失敗
            raise Exception.Create('SelectPalette = nil : ' + GetLastAPIErrorMes());
          end;
        end;

        if GetDIBits(DC, Bitmap.Handle, 0, Bitmap.Height,
                  Image, pInfo^, DIB_RGB_COLORS) = 0 then begin
          // 失敗
          raise Exception.Create('GetDIBits = 0 : ' + GetLastAPIErrorMes());
        end;

        if OldPal <> 0 then SelectPalette(DC, OldPal, True);
      finally
        ReleaseDC(0, DC);
      end;

      // StretchDIBits
      //   ※SetStretchBltModeはStretchDIBitsには不要と思われる。当方では問題は起きていない。
      ret := KStretchDIBits(Canvas.Handle,
                    r.Left,r.Top,r.Right-r.Left,r.Bottom-r.Top,
                    0,0,pInfo^.bmiHeader.biWidth,pInfo^.bmiHeader.biHeight,
                    Image,pInfo^,DIB_RGB_COLORS,SRCCOPY);

      if (ret = 0) or (ret = GDI_ERROR) then begin
        // 失敗
        raise Exception.Create('KStretchDIBits = ' + CurrToStr(ret) + ' : ' + GetLastAPIErrorMes());
      end;

    finally
      GlobalFree(THandle(Image));
    end;
end;

procedure THogeQRImage.Print(OfsX, OfsY: integer);
const
  MAX_RETRY: integer = 10;
  SLEEP_SHORT: integer = 20;
var
  Dest : TRect;
  bmp: TBitmap;
  DC, SavedDC : THandle;

  bPreview: boolean;
  bPrepare: boolean;
  sStatus: string;

  nRetry: integer;
  caPreError: cardinal;

  procedure AssignBmp();
  begin
    if Picture.Graphic is TBitmap then begin
      bmp.Assign(Picture.Bitmap);
    end
    else begin
      bmp.Assign(Picture.Graphic);
    end;

    // 24bitにする
    bmp.PixelFormat := pf24Bit;
  end;

begin
  CRITICAL_SECTION.Enter;
  try
    // ここまでのエラーコード
    caPreError := GetLastError();

    if Picture.Graphic is TMetafile then begin
      // TMetafileは、わからんので元の処理に丸投げして終了
      inherited Print(OfsX,OfsY);
      exit;
    end;

    if Picture.Graphic = nil then begin
      // 元画像がnilの場合、わからんので元の処理に丸投げして終了
      inherited Print(OfsX,OfsY);
      exit;
    end;

    if Picture.Graphic.Empty then begin
      // 元画像が空の場合、わからんので元の処理に丸投げして終了
      //   全面白の画像はEmpty扱いになるようだ
      inherited Print(OfsX,OfsY);
      exit;
    end;

    bPreview := ParentReport.QRPrinter.ShowingPreview;
    bPrepare := (not bPreview) and (ParentReport.QRPrinter.Destination = qrdMetafile);

    if bPreview then begin
      sStatus := '[Preview]';
    end
    else if bPrepare then begin
      sStatus := '[Prepare]';
    end
    else begin
      sStatus := '[Print]';
    end;

    if (not AutoSize) and bPrepare then begin
      // わざわざ後の処理をやる必要はない
      //   ※...と思っている。
      //   ※当方では問題は起きていないが不安な人は、このブロック取り払って下さい。
      exit;
    end;

    bmp := TBitmap.Create;
    try
      Dest.Top := QRPrinter.YPos(OfsY + Size.Top);
      Dest.Left := QRPrinter.XPos(OfsX + Size.Left);
      Dest.Right := QRPrinter.XPos(OfsX + Size.Width + Size.Left);
      Dest.Bottom := QRPrinter.YPos(OfsY + Size.Height + Size.Top);

      // とりあえずBitmapにする
      AssignBmp();

      if bmp.Empty then begin
        WriteLog('！bmp.Empty = true');
      end;

      // ※以下の繰り返し処理は、リトライで何とか復旧を試みていた頃の名残り。
      // ※現在はリトライのお世話にはなっていないけど、わざわざ消す程でもないので残している。
      // ※不要と思われる方は(ログ取りなど含めて)削除して下さい。

      if Stretch then begin
        nRetry := 0;

        while nRetry <= MAX_RETRY do begin
          try
            StretchDrawBitmap(QRPrinter.Canvas, Dest, bmp);
            break;
          except
            on E: Exception do begin
              Inc(nRetry);
              WriteLog(IntToStr(nRetry) + '回目失敗 - ' + sStatus + E.Message);
              Application.ProcessMessages;
              Sleep(SLEEP_SHORT);

              if (nRetry mod 2) = 0 then begin
                // 偶数回の失敗時、bmpの再生成
                bmp.Free;
                bmp := TBitmap.Create;
                AssignBmp();
              end;

              if nRetry = (MAX_RETRY + 1) then begin
                // 上限到達
                WriteLog('Print前 - ' + GetAPIErrorMessage(caPreError));
              end;
            end;
          end;
        end;
      end
      else begin
        IntersectClipRect(QRPrinter.Canvas.Handle, Dest.Left, Dest.Top, Dest.Right, Dest.Bottom);
        DC := GetDC(QRPrinter.Canvas.Handle);
        SavedDC := SaveDC(DC);
        try
          Dest.Right := Dest.Left +
            round(Picture.Width / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.XFactor);
          Dest.Bottom := Dest.Top +
            round(Picture.Height / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.YFactor);
          if Center then OffsetRect(Dest, (QRPrinter.XSize(Size.Width) -
              round(Picture.Width / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.XFactor)) div 2,
            (QRPrinter.YSize(Size.Height) -
              round(Picture.Height / Screen.PixelsPerInch * 254 * ParentReport.QRPrinter.YFactor)) div 2);

          nRetry := 0;

          while nRetry <= MAX_RETRY do begin
            try
              StretchDrawBitmap(QRPrinter.Canvas, Dest, bmp);
              break;
            except
              on E: Exception do begin
                Inc(nRetry);
                WriteLog(IntToStr(nRetry) + '回目失敗 - ' + sStatus + E.Message);
                Application.ProcessMessages;
                Sleep(SLEEP_SHORT);

                if (nRetry mod 2) = 0 then begin
                  // 偶数回の失敗時、bmpの再生成
                  bmp.Free;
                  bmp := TBitmap.Create;
                  AssignBmp();
                end;

                if nRetry = (MAX_RETRY + 1) then begin
                  // 上限到達
                  WriteLog('Print前 - ' + GetAPIErrorMessage(caPreError));
                end;
              end;
            end;
          end;

        finally
          RestoreDC(DC, SavedDC);
          SelectClipRgn(QRPrinter.Canvas.Handle, 0);
        end;
      end;

    finally
      bmp.Free;
    end;

  finally
    CRITICAL_SECTION.Leave;
  end;
end;

initialization
  CRITICAL_SECTION := TCriticalSection.Create;

finalization
  CRITICAL_SECTION.Free;

end.

----------------------------------------------------------------------------------------------

delphi xe2 적용 

기존 출력시 이미지 빠지는거 해결이 되었음

update test m set pkum  = (case u.cd when '2' then pkum  - u.janyear else pkum  end),

                          rkum  = (case u.cd when '1' then rkum - u.janyear else rkum end),

                          dt      = (case u.cd when '2' then dt - janmon else dt end),

                          ct      = (case u.cd when '1' then ct - janmon else ct end)

  from ( select s.member_mid, blsbcode, mbacode1, cd ,

          sum(case when mbcheck <> '' and (substr(blaccode,1,1)='b' or substr(blaccode,1,1)='p')

                     then case cd when '1' then coalesce(dt,0)

                                      else coalesce(dt,0) end

                else  0 end)::numeric janmon,

      sum(case when mbcheck <> '' and (substr(blaccode,1,1)='b' or substr(blaccode,1,1)='p')

                           then case cd when '1' then coalesce(pkum,0)

                                              else coalesce(rtkum,0) end

                     else 0 end )::numeric janyear

          from test s left outer join accset c

            on s.member_mid= c.member_mid

          and s.blaccode = c.mbacode

       where s.member_mid='test'

         and s.blsbcode='00'

         and mbcheck <> ''

         and coalesce(c.mbacode1,'') <>  ''

      group by s.member_mid, blsbcode, mbacode1, cd  ) u

where m.member_mid = u.member_mid

   and m.blsbcode = u.blsbcode

   and m.blaccode = u.mbacode1

메모리 4기가를 쓰고 있으나 프로그램 몇개만 띄워도 풀로 차서

업해달라고 요청했더니 8기가짜리 2개를 주심

문젠 32bit에서 3.25기가 이상 인식을 안한다는거 ㅜㅜ

분노의 검색후 인식할수 있는 방법을 찾아냄

아래와 같이 설정하면 간단하게 처리할수 있음 ^^

http://www.youtube.com/watch?v=AdjaBWH9mz8

( 하단 링크에 다운로드 경로 있음 )

요럿게 인식되었음

그나저나 16기가나 늘어났음에도 불구하고

빨라진 느낌은 없음 ㅎㅎㅎ

Table: Scope prefixes